home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 021-030 / amok29 / m2druka / druka.mod < prev    next >
Text File  |  1993-11-04  |  24KB  |  685 lines
  1. (*-----------------------------------------------------------------------------
  2.  
  3.     :Program.    druka.mod
  4.     :Author.     Rolf Kersten
  5.     :Address.    Ruetscher Str.121/416
  6.     :Phone.      0241/894364
  7.     :Copyright.  Public Domain
  8.     :Language.   Modula-2
  9.     :Translator. M2Amiga Modula-2 V3.2
  10.     :Update.     Version 1.03, 12.11.88
  11.     :Update.     Version 1.05, 27.11.88
  12.     :Update.     Version 1.06, 29.07.89   Anpassung an Level-Konzept
  13.     :Update.     Version 1.1,  16.09.89   Initialisierungs-Sequenzen können
  14.     :Update.                              eingegeben werden und mehr
  15.     :Contents.   Druka druckt ASCII-Files in verschiedenen Schriftgrößen, mit
  16.     :Remark.     Kopf und Perforationssprung
  17.     :Remark.     Usage: CLI:    (run) druka <filename>
  18.     :Remark.            WB :    dclick icon (+filename-icon)
  19.  
  20. -----------------------------------------------------------------------------*)
  21.  
  22. MODULE druka;
  23.  
  24. FROM Arts           IMPORT Assert,TermProcedure,CurrentLevel,Requester;
  25. FROM SYSTEM         IMPORT ADDRESS,ADR,BYTE,CAST;
  26. FROM Intuition      IMPORT ActivationFlags, ActivationFlagSet, boolGadget,
  27.                            Border, CloseWindow, Gadget, GadgetFlags,
  28.                            GadgetFlagSet, GadgetPtr, IDCMPFlags, IDCMPFlagSet,
  29.                            IntuiMessage, IntuiText, IntuiTextPtr, NewWindow,
  30.                            OpenWindow, PrintIText, RefreshWindowFrame,
  31.                            ScreenFlags, ScreenFlagSet, strGadget, StringInfo,
  32.                            WindowFlags, WindowFlagSet, WindowPtr;
  33. FROM Graphics       IMPORT jam1;
  34. FROM Dos            IMPORT Write,Lock,UnLock,FileLockPtr,FileHandlePtr,Open,
  35.                            Close,Read,dosName,newFile,accessRead;
  36. FROM Exec           IMPORT GetMsg,ReplyMsg,WaitPort;
  37. FROM Strings        IMPORT Length,Insert,Copy,Delete,Occurs,first,last;
  38. FROM Storage        IMPORT ALLOCATE,DEALLOCATE,Available;
  39. FROM FileSystem     IMPORT Lookup,ReadChar,File;
  40.                     IMPORT FileSystem;
  41. FROM Arguments      IMPORT GetArg;
  42.  
  43. (*---------------------------------------------------------------------------*)
  44.  
  45. TYPE Title          = ARRAY [0..70] OF CHAR;
  46.      BufferTyp      = ARRAY [0..80] OF CHAR;
  47.      ZeilenZeiger   = POINTER TO Zeile;
  48.      Zeile          = RECORD
  49.                         Vorige   : ZeilenZeiger;
  50.                         Folgende : ZeilenZeiger;
  51.                         Text     : ARRAY [1..80] OF CHAR;
  52.                       END;
  53.  
  54. (*---------------------------------------------------------------------------*)
  55.  
  56. VAR MyWindow                              : NewWindow;
  57.     MyWindowPtr                           : WindowPtr;
  58.     WindowTitle                           : Title;
  59.     msgclass                              : IDCMPFlagSet;
  60.     IntuiMsg                              : POINTER TO IntuiMessage;
  61.     MyIntuiSText                          : ARRAY [0..5] OF IntuiText;
  62.     MyIntuiText                           : ARRAY [0..7] OF IntuiText;
  63.     StringGadget                          : ARRAY [0..7] OF Gadget;
  64.     Schalter                              : ARRAY [1..6] OF Gadget;
  65.     CurrentGad                            : GadgetPtr;
  66.     Info                                  : ARRAY [0..7] OF StringInfo;
  67.     Rahmen,Srahmen1,Srahmen2,Srahmen3     : Border;
  68.     xyFeld,sxyFeld,pxyFeld1,pxyFeld2      : ARRAY [0..9]  OF INTEGER;
  69.     KText                                 : ARRAY [0..5],[0..9]  OF CHAR;
  70.     MyText                                : ARRAY [0..7],[0..45] OF CHAR;
  71.     tzahl                                 : ARRAY [1..2] OF CHAR;
  72.     Schrift                               : ARRAY [1..79] OF CHAR;
  73.     InitSequenz,SchmalSequenz,NLQSequenz,
  74.     SubscriptSequenz,ItalicsSequenz       : ARRAY [0..39] OF CHAR;
  75.     InitLaenge,SchmalLaenge,NLQLaenge,
  76.     SubscriptLaenge,ItalicsLaenge         : INTEGER;
  77.     Dateiname                             : BufferTyp;
  78.     Buffer                                : ARRAY [0..5] OF BufferTyp;
  79.     UndoBuffer                            : ARRAY [0..5] OF BufferTyp;
  80.     Buffer6,Buffer7,UndoBuffer6,
  81.     UndoBuffer7                           : ARRAY [0..3] OF CHAR;
  82.     Schmal,NLQ,Subscript,Italics,
  83.     Kopfzeile,quit,alarm,fflag,pflag      : BOOLEAN;
  84.     laenge                                : INTEGER;
  85.     lflag,dflag                           : FileLockPtr;
  86.     VolumeName                            : ARRAY [0..29] OF CHAR;
  87.     i                                     : LONGCARD;
  88.     erfolg,geschrieben                    : LONGINT;
  89.     textzeilen,seitenzahl,zeilenzahl,l,m  : LONGINT;
  90.     LinePtr,OldLinePtr,FirstLinePtr       : ZeilenZeiger;
  91.     ff                                    : File;
  92.     drucker                               : FileHandlePtr;
  93.     DrukaLevel                            : INTEGER;
  94.  
  95. (*---------------------------------------------------------------------------*)
  96. (* Ciao: Arts.TermProcedure, wird bei gewolltem und ungewollten
  97.          Programmabruch aufgerufen, schließt alles, was offen herumliegt.    *)
  98. (*---------------------------------------------------------------------------*)
  99.  
  100. PROCEDURE Ciao;
  101.  BEGIN
  102.     IF DrukaLevel >= CurrentLevel() THEN
  103.       IF pflag THEN Close(drucker) END;
  104.       IF fflag THEN FileSystem.Close(ff) END;
  105.       CloseWindow(MyWindowPtr);
  106.     END;
  107.  END Ciao;
  108.  
  109. (*---------------------------------------------------------------------------*)
  110.  
  111. PROCEDURE DruckChar(k : FileHandlePtr; ch : CHAR);
  112.  BEGIN
  113.     IF k # NIL THEN
  114.        geschrieben := Write(k,ADR(ch),SIZE(ch));
  115.     END;
  116.  END DruckChar;
  117.  
  118. (*---------------------------------------------------------------------------*)
  119.  
  120. PROCEDURE DruckUmlaut(umdruck : FileHandlePtr; Umlaut : CHAR);
  121.  BEGIN
  122.     DruckChar(umdruck,CHR(27));
  123.     DruckChar(umdruck,"R");        (* Deutschen Zeichensatz ein... *)
  124.     DruckChar(umdruck,CHR(2));
  125.     DruckChar(umdruck,Umlaut);
  126.     DruckChar(umdruck,CHR(27));
  127.     DruckChar(umdruck,"R");        (* ...und wieder aus            *)
  128.     DruckChar(umdruck,CHR(0));
  129.  END DruckUmlaut;
  130.  
  131. (*---------------------------------------------------------------------------*)
  132.  
  133. PROCEDURE DruckString(k : FileHandlePtr; str: ARRAY OF CHAR);
  134.  BEGIN
  135.     IF k # NIL THEN
  136.        geschrieben := Write(k,ADR(str),SIZE(str));
  137.     END;
  138.  END DruckString;
  139.  
  140. (*---------------------------------------------------------------------------*)
  141.  
  142. PROCEDURE DruckLn(k : FileHandlePtr);
  143.   VAR LF : CHAR;
  144.   BEGIN
  145.     LF := 12C;
  146.     IF k # NIL THEN
  147.        geschrieben := Write(k,ADR(LF),SIZE(LF));
  148.     END;
  149.  END DruckLn;
  150.  
  151. (*---------------------------------------------------------------------------*)
  152.  
  153. PROCEDURE Schlagalarm (alarmtext : ARRAY OF CHAR): BOOLEAN;
  154.  BEGIN
  155.    alarm := Requester(ADR("druka:"),ADR(alarmtext),
  156.                       NIL,ADR("Weiter"));
  157.    RETURN alarm;
  158. END Schlagalarm;
  159.  
  160. (*---------------------------------------------------------------------------*)
  161.  
  162. PROCEDURE MakeLine(VAR lnPtr : ZeilenZeiger) : BOOLEAN;
  163.  BEGIN
  164.     IF Available(SIZE(Zeile)) THEN
  165.        ALLOCATE (lnPtr,SIZE(Zeile));
  166.        WITH lnPtr^ DO
  167.           Vorige     := NIL;
  168.           Folgende   := NIL;
  169.           Text[1]    := 0C;
  170.        END;
  171.        RETURN TRUE;
  172.     ELSE
  173.        lnPtr := NIL;
  174.        RETURN FALSE;
  175.     END;
  176.  END MakeLine;
  177.  
  178. (*---------------------------------------------------------------------------*)
  179.  
  180. PROCEDURE FindFirstLine(lnPtr : ZeilenZeiger ) : ZeilenZeiger;
  181.  BEGIN
  182.     WHILE lnPtr^.Vorige # NIL DO
  183.        lnPtr := lnPtr^.Vorige;
  184.     END;
  185.     RETURN lnPtr;
  186.  END FindFirstLine;
  187.  
  188. (*---------------------------------------------------------------------------*)
  189.  
  190. PROCEDURE Ladetext ( Filename : ARRAY OF CHAR );
  191.  BEGIN
  192.      fflag := TRUE;
  193.      Lookup(ff,Filename,2000,FALSE); (* 2000 = Buffergröße, Ladetext lädt *)
  194.      IF MakeLine(LinePtr) THEN;      (* längere Files so 4x schneller     *)
  195.         OldLinePtr := LinePtr;
  196.         quit := TRUE;
  197.         WHILE (LinePtr # NIL) AND (ff.eof = FALSE) DO
  198.            i := 0;
  199.            REPEAT
  200.             i := i+1;
  201.             ReadChar(ff,LinePtr^.Text[i]);
  202.            UNTIL ((LinePtr^.Text[i] = CHR(10)) OR (i = 80)) OR
  203.                   (LinePtr^.Text[i] = CHR(13));
  204.            OldLinePtr := LinePtr;
  205.            IF MakeLine(LinePtr^.Folgende) THEN
  206.               LinePtr         := LinePtr^.Folgende;
  207.               LinePtr^.Vorige := OldLinePtr;
  208.            END;
  209.         END;
  210.      fflag := FALSE; FileSystem.Close(ff)
  211.      END;
  212.   END Ladetext;
  213.  
  214. (*---------------------------------------------------------------------------*)
  215.  
  216. PROCEDURE  BGad ( VAR Sch : Gadget; VAR nSch : Gadget;
  217.                      VAR SchalterText : ARRAY OF CHAR; le : INTEGER );
  218.  BEGIN
  219.     WITH MyIntuiSText[le] DO
  220.       frontPen := 1 ; backPen := 0 ;
  221.       drawMode := jam1;
  222.       leftEdge := 1 ; topEdge := 2;
  223.       nextText := NIL;
  224.       iText := ADR(SchalterText);
  225.    END;
  226.    WITH Sch DO
  227.       nextGadget := ADR(nSch);
  228.       leftEdge := le*100+20 ; topEdge := 35;
  229.       width    := 80 ; height  := 11;
  230.       flags := GadgetFlagSet{};
  231.       activation := ActivationFlagSet{gadgImmediate,relVerify,toggleSelect};
  232.       gadgetType := boolGadget;
  233.       gadgetRender := ADR(Rahmen);
  234.       selectRender := NIL;
  235.       gadgetText   := ADR(MyIntuiSText[le]);
  236.       specialInfo := NIL;
  237.       gadgetID := le+1;
  238.       userData := NIL;
  239.    END;
  240.    IF Sch.gadgetID = 6 THEN
  241.       Sch.activation := ActivationFlagSet{gadgImmediate,relVerify}
  242.    END;
  243.  END BGad;
  244.  
  245. (*---------------------------------------------------------------------------*)
  246.  
  247. PROCEDURE PrefGad (VAR Pref : Gadget; VAR nPref : Gadget;
  248.                    ID : INTEGER; left,top,length : INTEGER;
  249.                    VAR border : Border; VAR info : StringInfo);
  250.  BEGIN
  251.   WITH Pref DO
  252.     nextGadget := ADR(nPref);
  253.     leftEdge := left; topEdge := top;
  254.     width := length; height := 10;
  255.     flags := GadgetFlagSet{};
  256.     activation := ActivationFlagSet{gadgImmediate,relVerify,toggleSelect};
  257.     gadgetType := strGadget;
  258.     gadgetRender := ADR(border);
  259.     selectRender := NIL;
  260.     gadgetText   := NIL;
  261.     specialInfo := ADR(info);
  262.     gadgetID := ID;
  263.     userData := NIL;
  264.    END;
  265.  END PrefGad;
  266.  
  267. (*---------------------------------------------------------------------------*)
  268.  
  269. PROCEDURE InitInfo (VAR Info : StringInfo;
  270.                     VAR Buffer,UndoBuffer : ARRAY OF CHAR);
  271.  BEGIN
  272.     WITH Info DO
  273.       buffer := ADR(Buffer) ; undoBuffer := ADR(UndoBuffer) ;
  274.       bufferPos := 0 ; maxChars := SIZE(Buffer) ; dispPos := 0 ;
  275.       numChars := SIZE(Buffer);
  276.       END ;
  277.  END InitInfo;
  278.  
  279. (*---------------------------------------------------------------------------*)
  280.  
  281. PROCEDURE InitBorder (VAR Rahmen : Border; VAR sxyfeld : ARRAY OF INTEGER);
  282.  BEGIN
  283.   WITH Rahmen DO
  284.      leftEdge := -1 ; topEdge := -2;          (* Rahmen des Eingabegadgets *)
  285.      frontPen := 1; backPen := 0;
  286.      drawMode := jam1;
  287.      count := 5; xy := ADR(sxyfeld);
  288.      nextBorder := NIL;
  289.    END;
  290.  END InitBorder;
  291.  
  292. (*---------------------------------------------------------------------------*)
  293.  
  294. PROCEDURE SetzeRahmen (VAR sxyfeld : ARRAY OF INTEGER; length : INTEGER);
  295.  BEGIN
  296.    sxyfeld[0] := 0;       sxyfeld[1] := 0;
  297.    sxyfeld[2] := length;  sxyfeld[3] := 0;
  298.    sxyfeld[4] := length;  sxyfeld[5] := 12;
  299.    sxyfeld[6] := 0;       sxyfeld[7] := 12;
  300.    sxyfeld[8] := 0;       sxyfeld[9] := 0;
  301.  END SetzeRahmen;
  302.  
  303. (*---------------------------------------------------------------------------*)
  304.  
  305. PROCEDURE SetzeText (num : INTEGER; left,top : INTEGER);
  306.  VAR nText : IntuiTextPtr;
  307.  BEGIN
  308.    IF num < 7 THEN
  309.      nText := ADR(MyIntuiText[num+1]);
  310.    ELSE
  311.      nText := NIL;
  312.    END;
  313.    WITH MyIntuiText[num] DO
  314.      frontPen := 3 ; backPen := 0 ;
  315.      drawMode := jam1;
  316.      leftEdge := left ; topEdge := top;
  317.      nextText := nText;
  318.      iTextFont := NIL;
  319.      iText := ADR(MyText[num]);
  320.    END;
  321.  END SetzeText;
  322.  
  323. (*---------------------------------------------------------------------------*)
  324.  
  325. PROCEDURE Auswertung (VAR Buffer : ARRAY OF CHAR;
  326.                       VAR Ergebnis : ARRAY OF CHAR; VAR laenge : INTEGER);
  327.  VAR i,h : INTEGER;
  328.  
  329.  PROCEDURE HexAuswertung;
  330.   PROCEDURE HexToDez;
  331.    BEGIN
  332.     INC(i);
  333.     CASE Buffer[i] OF
  334.        "0".."9" : h := h + INTEGER(Buffer[i])-ORD("0");
  335.      | "A".."F",
  336.        "a".."f" : h := h + INTEGER(Buffer[i])-ORD("A");
  337.     ELSE alarm := Schlagalarm("Fehler in Hexzahl");
  338.     END; (* CASE *);
  339.    END HexToDez;
  340.  BEGIN
  341.     h := 0;
  342.     HexToDez;
  343.     h := h*16;
  344.     HexToDez;
  345.     INC(laenge);
  346.     Ergebnis[laenge] := CHR(h);
  347.     INC(i);
  348.     IF (Buffer[i] # ";") AND (Buffer[i] #"'") THEN
  349.        HexAuswertung;
  350.     ELSE INC(i);
  351.     END;
  352.  END HexAuswertung;
  353.  
  354.  PROCEDURE ASCAuswertung;
  355.   BEGIN
  356.     WHILE Buffer[i+1] # "'" DO
  357.       INC(i); INC(laenge);
  358.       Ergebnis[laenge] := Buffer[i];
  359.     END;
  360.     INC(i,2);
  361.   END ASCAuswertung;
  362.  
  363.  PROCEDURE DezAuswertung;
  364.   BEGIN
  365.    h := 0;
  366.    WHILE ("0" <= Buffer[i]) AND (Buffer[i] <= "9") DO
  367.     h := h*10 + INTEGER(Buffer[i])-ORD("0");
  368.     INC(i);
  369.    END;
  370.    IF h <= 255 THEN
  371.      INC(laenge);
  372.      Ergebnis[laenge] := CHR(h);
  373.    ELSE
  374.      alarm := Schlagalarm("Fehler in Dezimalzahl");
  375.    END;
  376.   END DezAuswertung;
  377.  
  378.  BEGIN
  379.   laenge := -1; i := 0;
  380.   REPEAT
  381.     CASE Buffer[i] OF
  382.         "$" : HexAuswertung;
  383.       | "'" : ASCAuswertung;
  384.       | ";" : INC(i);
  385.       | ELSE DezAuswertung;
  386.     END;
  387.   UNTIL i >= Length(Buffer)-1;
  388.  END Auswertung;
  389.  
  390. (*---------------------------------------------------------------------------*)
  391.  
  392. PROCEDURE DAusgabe;
  393.   BEGIN
  394.     drucker := Open(ADR("PAR:"),newFile);
  395.     pflag := TRUE;
  396.     FOR i := 0 TO InitLaenge DO
  397.       DruckChar (drucker,InitSequenz[i]);
  398.     END;
  399.     IF Schmal THEN
  400.       FOR i := 0 TO SchmalLaenge DO
  401.         DruckChar (drucker,SchmalSequenz[i]);
  402.       END;
  403.     END;
  404.     IF NLQ AND (NOT(Schmal) AND NOT(Subscript)) THEN
  405.       FOR i := 0 TO NLQLaenge DO
  406.         DruckChar (drucker,NLQSequenz[i]);
  407.       END;
  408.     END;
  409.     IF Italics THEN
  410.       FOR i := 0 TO ItalicsLaenge DO
  411.         DruckChar (drucker,ItalicsSequenz[i]);
  412.       END;
  413.     END;
  414.     IF Subscript THEN
  415.       FOR i := 0 TO SubscriptLaenge DO
  416.         DruckChar (drucker,SubscriptSequenz[i]);
  417.       END;
  418.     END;
  419.  
  420. (*---------------- Berechnung von Zeilen- und Seitenzahl -------------------*)
  421.  
  422.     textzeilen := 0;
  423.     LinePtr := FindFirstLine(OldLinePtr);
  424.     OldLinePtr := LinePtr;
  425.     WHILE LinePtr # NIL DO
  426.        textzeilen := textzeilen+1;
  427.        LinePtr := LinePtr^.Folgende;
  428.     END;
  429.     IF Subscript THEN zeilenzahl := Info[7].longInt;
  430.     ELSE zeilenzahl := Info[6].longInt; END;
  431.     IF Kopfzeile THEN zeilenzahl := zeilenzahl-5; END;
  432.     seitenzahl := textzeilen DIV zeilenzahl;
  433.     IF (textzeilen MOD zeilenzahl) # 0 THEN seitenzahl := seitenzahl+1; END;
  434.     IF (textzeilen < zeilenzahl ) THEN seitenzahl := 1; END;
  435.     LinePtr := FindFirstLine(OldLinePtr);
  436.     OldLinePtr := LinePtr;
  437.  
  438. (*------------------------------ Druckschleife -----------------------------*)
  439.     l := Occurs(Dateiname,first,":",FALSE);
  440.     IF l # last THEN
  441.       Delete(Dateiname,first,l);
  442.       Insert(Dateiname,first,VolumeName);
  443.     END;
  444.     Schrift := "Dateiname : ";
  445.     Insert(Schrift,13,Dateiname);
  446.     Insert(Schrift,66,"Seite :   /");
  447.     tzahl[1] := CHR((seitenzahl DIV 10)+ORD("0"));
  448.     IF tzahl[1] = "0" THEN tzahl[1] := " " END;
  449.     tzahl[2] := CHR((seitenzahl MOD 10)+ORD("0"));
  450.     Insert(Schrift,77,tzahl);
  451.     l := 0 ;
  452.     REPEAT
  453.        l := l+1;
  454.        IF Kopfzeile THEN
  455.           FOR m := 1 TO 79 DO
  456.              DruckChar(drucker,"-");
  457.           END;
  458.           DruckLn(drucker);
  459.           tzahl[1] := CHR((l DIV 10)+ORD("0"));
  460.           IF tzahl[1] = "0" THEN tzahl[1] := " " END;
  461.           tzahl[2] := CHR((l MOD 10)+ORD("0"));
  462.           Delete(Schrift,74,2);
  463.           Insert(Schrift,74,tzahl);
  464.           DruckString(drucker,Schrift);
  465.           DruckLn(drucker);
  466.           FOR m := 1 TO 79 DO
  467.              DruckChar(drucker,"-");
  468.           END;
  469.           DruckLn(drucker);
  470.        END;
  471.        FOR m := 1 TO zeilenzahl DO
  472.           IF LinePtr # NIL THEN
  473.              FOR i := 1 TO Length(LinePtr^.Text) DO
  474.                 CASE LinePtr^.Text[i] OF
  475.                    "ä" : DruckUmlaut(drucker,CHR(123))
  476.                  | "ö" : DruckUmlaut(drucker,CHR(124))
  477.                  | "ü" : DruckUmlaut(drucker,CHR(125))
  478.                  | "ß" : DruckUmlaut(drucker,CHR(126))
  479.                  | "Ä" : DruckUmlaut(drucker,CHR(91))
  480.                  | "Ö" : DruckUmlaut(drucker,CHR(92))
  481.                  | "Ü" : DruckUmlaut(drucker,CHR(93))
  482.                  | ELSE  DruckChar(drucker,LinePtr^.Text[i])
  483.                 END
  484.              END;
  485.              LinePtr := LinePtr^.Folgende;
  486.           ELSE
  487.              DruckLn(drucker);
  488.           END;
  489.        END;
  490.        DruckChar(drucker,CHR(12));
  491.     UNTIL l = seitenzahl;
  492.  IF drucker # NIL THEN pflag := FALSE; Close(drucker) END;
  493.  END DAusgabe;
  494.  
  495. (*---------------------------------------------------------------------------*)
  496.  
  497. PROCEDURE Drucke;
  498.   BEGIN
  499.      lflag := Lock(ADR(Dateiname),accessRead);
  500.      Copy(VolumeName,lflag^.volume^.name^,1,30);
  501.      UnLock(lflag);
  502.      dflag := Lock(ADR("par:"),2);
  503.      UnLock(dflag);
  504.      IF lflag = NIL THEN
  505.        alarm := Schlagalarm("Datei nicht gefunden!")
  506.      ELSE
  507.        Ladetext (Dateiname);
  508.        alarm := Requester(ADR("druka:"),ADR("Drucker eingeschaltet?"),
  509.                           ADR("Abbruch"),ADR("Druck!"));
  510.        IF alarm = FALSE THEN
  511.          DAusgabe;
  512.        END;
  513.      END;
  514.   END Drucke;
  515.  
  516. (*---------------------------------------------------------------------------*)
  517.  
  518. PROCEDURE Positiv(gptr : GadgetPtr );
  519.   BEGIN
  520.     CASE gptr^.gadgetID OF
  521.      |  1 : Schmal     := NOT(Schmal);
  522.      |  2 : NLQ        := NOT(NLQ);
  523.      |  3 : Subscript  := NOT(Subscript);
  524.      |  4 : Italics    := NOT(Italics);
  525.      |  5 : Kopfzeile  := NOT(Kopfzeile);
  526.      |  6 : IF Info[0].buffer # NIL THEN
  527.                FOR i := 0 TO 80 DO
  528.                   Dateiname[i] := Buffer[0,i];
  529.                END;
  530.             END;
  531.             IF Length(Dateiname) # 0 THEN
  532.               Drucke;
  533.             END;
  534.      | 11 : Auswertung(Buffer[1],InitSequenz,InitLaenge);
  535.      | 12 : Auswertung(Buffer[2],SchmalSequenz,SchmalLaenge);
  536.      | 13 : Auswertung(Buffer[3],NLQSequenz,NLQLaenge);
  537.      | 14 : Auswertung(Buffer[4],ItalicsSequenz,ItalicsLaenge);
  538.      | 15 : Auswertung(Buffer[5],SubscriptSequenz,SubscriptLaenge);
  539.      | ELSE
  540.     END;
  541.   END Positiv;
  542.  
  543. (*---------------------------------------------------------------------------*)
  544. (*                             Hauptprogramm                                 *)
  545. (*---------------------------------------------------------------------------*)
  546.  
  547. BEGIN
  548.  
  549. (*--------------------------- Initialisierung -------------------------------*)
  550.  
  551.    Schmal := FALSE; NLQ := FALSE; Subscript := FALSE; Italics := FALSE;
  552.    Kopfzeile := FALSE;
  553.  
  554.    Buffer[1] := "28'@'13;27'x'0;27'C'0;11;27'R'0;";   (* InitSequenz      *)
  555.    Buffer[2] := "27'M'28'S'1;27'l'20;";               (* SchmalSequenz    *)
  556.    Buffer[3] := "27'x'1;";                            (* NLQSequenz       *)
  557.    Buffer[4] := "27'4';";                             (* ItalicsSequnz    *)
  558.    Buffer[5] := "27'S'1;27'3'20;";                    (* SubscriptSequenz *)
  559.    Buffer6 := "62"; Info[6].longInt := 62;     (* Anzahl Zeilen normal    *)
  560.    Buffer7 := "93"; Info[7].longInt := 93;     (* Anzahl Zeilen subscript *)
  561.  
  562.    DrukaLevel := CurrentLevel();
  563.    TermProcedure(Ciao);
  564.    WindowTitle := "DRUKA  V1.2 [hG] 16.Sept.1989";
  565.  
  566.    WITH MyWindow DO
  567.       leftEdge := 0 ; topEdge := 10 ;
  568.       width := 640 ; height := 50 ;
  569.       detailPen := 0 ; blockPen := 1 ;
  570.       idcmpFlags := IDCMPFlagSet{closeWindow,newSize,gadgetUp,gadgetDown} ;
  571.       flags := WindowFlagSet{windowSizing,windowDrag,windowDepth,
  572.                              windowClose,windowRefresh,activate} ;
  573.       firstGadget := ADR(Schalter[1]) ;
  574.       checkMark := NIL ;
  575.       title := ADR(WindowTitle) ;
  576.       bitMap := NIL ;
  577.       type := ScreenFlagSet{wbenchScreen} ;
  578.       minWidth := 125 ; maxWidth := 640 ;
  579.       minHeight := 20 ; maxHeight :=140 ;
  580.    END ;
  581.  
  582.    WITH Rahmen DO
  583.       leftEdge := -1 ; topEdge := -1 ;        (* Rahmen der Auswahlgadgets *)
  584.       frontPen := 1 ; backPen := 0 ;
  585.       drawMode := jam1 ;
  586.       count := 5 ; xy := ADR(xyFeld) ;
  587.       nextBorder := NIL ;
  588.    END ;
  589.    SetzeRahmen(xyFeld,81);
  590.  
  591.    InitBorder (Srahmen1,sxyFeld);   SetzeRahmen (sxyFeld,481);
  592.    InitBorder (Srahmen2,pxyFeld1); SetzeRahmen (pxyFeld1,401);
  593.    InitBorder (Srahmen3,pxyFeld2); SetzeRahmen (pxyFeld2,33);
  594.    DEC(pxyFeld2[5]); DEC(pxyFeld2[7]);
  595.  
  596.    Buffer[0]:= " ";
  597.    laenge := 80;
  598.    GetArg(1,Buffer[0],laenge);          (* Übername des Dateinamens von dem   *)
  599.    UndoBuffer[0] := " " ;               (* Programmaufrufsargument            *)
  600.  
  601. (*-------------------------- Setze Gadgets ---------------------------------*)
  602.  
  603.    InitInfo(Info[0],Buffer[0],UndoBuffer[0]);
  604.    InitInfo(Info[1],Buffer[1],UndoBuffer[1]);
  605.    InitInfo(Info[2],Buffer[2],UndoBuffer[2]);
  606.    InitInfo(Info[3],Buffer[3],UndoBuffer[3]);
  607.    InitInfo(Info[4],Buffer[4],UndoBuffer[4]);
  608.    InitInfo(Info[5],Buffer[5],UndoBuffer[5]);
  609.    InitInfo(Info[6],Buffer6,UndoBuffer6);
  610.    InitInfo(Info[7],Buffer7,UndoBuffer7);
  611.  
  612.    KText[0] := " Schmal  "; BGad (Schalter[1],Schalter[2],KText[0],0);
  613.    KText[1] := "   NLQ   "; BGad (Schalter[2],Schalter[3],KText[1],1);
  614.    KText[2] := "Subscript"; BGad (Schalter[3],Schalter[4],KText[2],2);
  615.    KText[3] := " Italics "; BGad (Schalter[4],Schalter[5],KText[3],3);
  616.    KText[4] := "Kopfzeile"; BGad (Schalter[5],Schalter[6],KText[4],4);
  617.    KText[5] := " Druck ! "; BGad (Schalter[6],StringGadget[0],KText[5],5);
  618.  
  619.    PrefGad (StringGadget[0],StringGadget[1],10,120,14,480,
  620.             Srahmen1,Info[0]);                           (* Dateiname     *)
  621.    INCL(StringGadget[0].activation,stringCenter);
  622.  
  623.    PrefGad (StringGadget[1],StringGadget[2],11,165,55,400,
  624.             Srahmen2,Info[1]);                           (* init          *)
  625.    PrefGad (StringGadget[2],StringGadget[3],12,165,69,400,
  626.             Srahmen2,Info[2]);                           (* Schmal        *)
  627.    PrefGad (StringGadget[3],StringGadget[4],13,165,83,400,
  628.             Srahmen2,Info[3]);                           (* NLQ           *)
  629.    PrefGad (StringGadget[4],StringGadget[5],14,165,97,400,
  630.             Srahmen2,Info[4]);                           (* Italics       *)
  631.    PrefGad (StringGadget[5],StringGadget[6],15,165,111,400,
  632.             Srahmen2,Info[5]);                           (* Subscript     *)
  633.  
  634.    PrefGad (StringGadget[6],StringGadget[7],16,165,125,33,
  635.             Srahmen3,Info[6]);                           (* Zeilen normal *)
  636.    INCL(StringGadget[6].activation,longint);
  637.  
  638.    PrefGad (StringGadget[7],StringGadget[7],17,435,125,33,
  639.             Srahmen3,Info[7]);                           (* Zeilen sub    *)
  640.    INCL(StringGadget[7].activation,longint);
  641.    StringGadget[7].nextGadget := NIL;
  642.  
  643.    Auswertung(Buffer[1],InitSequenz,InitLaenge);
  644.    Auswertung(Buffer[2],SchmalSequenz,SchmalLaenge);
  645.    Auswertung(Buffer[3],NLQSequenz,NLQLaenge);
  646.    Auswertung(Buffer[4],ItalicsSequenz,ItalicsLaenge);
  647.    Auswertung(Buffer[5],SubscriptSequenz,SubscriptLaenge);
  648.  
  649. (*----------------------- Eröffne Programmfenster ---------------------------*)
  650.  
  651.    MyText[0] := "Dateiname : ";     SetzeText(0,20,15);
  652.    MyText[1] := "     InitSequenz"; SetzeText(1,30,55);
  653.    MyText[2] := "   SchmalSequenz"; SetzeText(2,30,69);
  654.    MyText[3] := "      NLQSequenz"; SetzeText(3,30,84);
  655.    MyText[4] := "  ItalicsSequenz"; SetzeText(4,30,97);
  656.    MyText[5] := "SubscriptSequenz"; SetzeText(5,30,111);
  657.    MyText[6] := "Zeilen/Seite normal";    SetzeText(6,8,125);
  658.    MyText[7] := "Zeilen/Seite subscript"; SetzeText(7,254,125);
  659.  
  660.    MyWindowPtr := OpenWindow(MyWindow) ;
  661.    Assert(MyWindowPtr # NIL, ADR("Fenster nicht geöffnet"));
  662.  
  663.    PrintIText (MyWindowPtr^.rPort,ADR(MyIntuiText[0]),0,0);
  664.  
  665. (*------- Hauptschleife, wartet auf Betätigung des Schließgadgets -----------*)
  666.  
  667.    LOOP
  668.       WaitPort(MyWindowPtr^.userPort);
  669.       IntuiMsg := GetMsg(MyWindowPtr^.userPort) ;
  670.       WHILE IntuiMsg # NIL DO
  671.          msgclass := IntuiMsg^.class ; CurrentGad := IntuiMsg^.iAddress;
  672.          ReplyMsg(IntuiMsg) ;
  673.          IF (closeWindow IN msgclass) THEN
  674.            EXIT ;
  675.          ELSIF (gadgetUp IN msgclass) THEN
  676.            Positiv(CurrentGad);
  677.          ELSIF (newSize IN msgclass) THEN
  678.            PrintIText (MyWindowPtr^.rPort,ADR(MyIntuiText[0]),0,0);
  679.          END  ;
  680.          IntuiMsg := GetMsg(MyWindowPtr^.userPort) ;
  681.       END  ;
  682.    END  ;
  683.  
  684. END druka.
  685.